home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
SHELLS
/
SZ2
/
GDIALOG.IMP
< prev
next >
Wrap
Text File
|
1992-08-31
|
14KB
|
378 lines
{*******************************************************************
GDIALOG.IMP
*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
DIALOG UTILITIES
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
COPY DIALOG - Otherwise known as "reverse polymorphism"
===================================================================}
function CopyDialog ( DSource , DTarget : PDialog ) : boolean ;
{-------------------------------------------------------------------
ACTION
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
P^.Owner := DTarget ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
var
R : TRect ;
begin
CopyDialog := FALSE ; { set flag }
if DSource = NIL then EXIT ; { nothing to do }
if DTarget = NIL then EXIT ; { nothing to do }
DSource^.GetBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
TARGET - change elements, then switch ownership.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DTarget^ do
begin
Dispose ( Frame , Done ) ; { free }
if Title <> NIL then
DisposeStr ( Title ) ; { free }
ChangeBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
COMPONENTS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
Frame := DSource^.Frame ; { screen }
Title := DSource^.Title ; { screen }
Buffer := DSource^.Buffer ; { screen }
Next := DSource^.Next ; { sub-view }
Last := DSource^.Last ; { sub-view }
Current := DSource^.Current ; { sub-view }
Owner := DSource^.Owner ; { parent }
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SOURCE - make sure we don't dispose stuff we need!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DSource^ do
begin
Frame := NIL ; { screen }
Title := NIL ; { screen }
Buffer := NIL ; { screen }
Next := NIL ; { sub-view }
Last := NIL ; { sub-view }
Current := NIL ; { sub-view }
Owner := NIL ; { parent }
end ;
Dispose ( DSource , Done ) ; { dump original }
DTarget^.ForEach ( @Action ) ; { fields }
CopyDialog := TRUE ; { set flag }
end ;
{===================================================================
SCROLLBAR - Vertical, either side
===================================================================}
function AddVScrollBar ( G : PGroup ; Right : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Right then
begin
R.A := R.B ;
dec ( R.A.X ) ; { go left, to be visible }
dec ( R.B.Y ) ; { don't cover corner }
R.A.Y := 1 ; { don't cover corner }
end
else
begin
R.B.X := R.A.X + 1 ; { go right, to be visible }
R.A.Y := 1 ; { don't cover corner }
dec ( R.B.Y ) ; { don't cover corner }
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddVScrollBar := SB ;
end ;
{===================================================================
SCROLLBAR - Horizontal, top or bottom
===================================================================}
function AddHScrollBar ( G : PGroup ; Bottom : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Bottom then
begin
R.A.Y := R.B.Y - 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ; { don't cover corner }
end
else
begin
R.B.Y := R.A.Y + 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ;
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddHScrollBar := SB ;
end ;
{===================================================================
COUNT - Views which can hold data (non-static).
===================================================================}
function TActiveCount ( D : PDialog ) : byte ;
var
x : byte ;
procedure DoThis ( P : PView ) ; FAR ;
begin
if P^.DataSize = 0 then EXIT ;
inc ( x ) ;
end ;
begin
x := 0 ;
D^.ForEach ( @DoThis ) ;
TActiveCount := x ;
end ;
{===================================================================
Return pointer to view with data.
===================================================================}
function DataRecPtr ( D : PDialog ; Fnum : byte ) : pointer ;
var
x : byte ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
function DoThis ( P : PView ) : boolean ; FAR ;
var
S : string ;
begin
DoThis := FALSE ;
if P^.DataSize = 0 then EXIT ;
dec ( x ) ;
if x <> Fnum then EXIT ;
DoThis := TRUE ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
DataRecPtr := NIL ;
x := TActiveCount ( D ) + 1 ;
if FNum > x then EXIT ;
DataRecPtr := D^.FirstThat ( @DoThis ) ;
end ;
{===================================================================
SET - Reference View's data by view order number.
===================================================================}
procedure SetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.SetData ( Data^ ) ;
P^.DrawView ;
end ;
{===================================================================
GET - Reference View's data by view order number.
===================================================================}
procedure GetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.GetData ( Data^ ) ;
end ;
{===================================================================
BUTTON ON/OFF
===================================================================}
procedure SetButtons ( D : PDialog ; On : boolean ) ;
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TButton ) then EXIT ;
if On then
P^.Show
else
P^.Hide ;
end ;
var
Temp : PView ;
begin
Temp := D^.Current ;
D^.ForEach ( @DoThis ) ;
Temp^.Select ;
end ;
{===================================================================
STATIC TEXT ON/OFF
===================================================================}
procedure SetStaticText ( D : PDialog ; On : boolean ) ;
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TStaticText ) then EXIT ;
if On then
P^.Show
else
P^.Hide ;
end ;
var
Temp : PView ;
begin
Temp := D^.Current ;
D^.ForEach ( @DoThis ) ;
Temp^.Select ;
end ;
{===================================================================
Use DESKTOP to ExecView dialog. Turns on "ofCentered" for
PDialog^.Options, to compensate for VGA/EGA modes (so it doesn't
matter what VideoMode we're in).
Returns cmXXXX & data pointer; if there is not enough memory or
the dialog is missing from a resource file, user is notified of
the error via a message box.
===================================================================}
function ExecDialog ( P : PDialog ; Data : pointer ) : word ;
var
Result : word ;
begin
ExecDialog := cmCancel ;
if P = NIL then
begin
MessageBox ( ^C'Dialog is missing!' ,
NIL ,
mfError + mfCancelButton ) ;
EXIT ;
end ;
P := PDIALOG ( Application^.ValidView ( P ) ) ;
if P = NIL then EXIT ;
if Data <> NIL then
P^.SetData ( Data^ ) ;
P^.Options := P^.Options OR ofCentered ; { EGA/VGA }
Result := Desktop^.ExecView ( P ) ;
if Result <> cmCancel then
if Data <> NIL then
P^.GetData ( Data^ ) ;
Dispose ( P , Done ) ;
ExecDialog := Result ;
end ;
{===================================================================
PALETTE - can be customized for program, but this works for most.
===================================================================}
function SetColorsDialog : PDialog ;
begin
SetColorsDialog := New ( PColorDialog ,
Init ( '' ,
ColorGroup ( 'Ascii table' ,
ColorItem ( 'Frame passive' , 24 ,
ColorItem ( 'Frame active' , 25 ,
ColorItem ( 'Frame icons' , 26 ,
ColorItem ( 'Scroll bar page' , 27 ,
ColorItem ( 'Scroll bar icons' , 28 ,
ColorItem ( 'Text' , 29 ,
NIL)))))) ,
ColorGroup ( 'Desktop' ,
ColorItem ( 'Color' , 32 ,
NIL) ,
ColorGroup ( 'Dialogs' ,
ColorItem ( 'Frame/background' , 33 ,
ColorItem ( 'Frame icons' , 34 ,
ColorItem ( 'Scroll bar page' , 35 ,
ColorItem ( 'Scroll bar icons' , 36 ,
ColorItem ( 'Static text' , 37 ,
ColorItem ( 'Label normal' , 38 ,
ColorItem ( 'Label selected' , 39 ,
ColorItem ( 'Label shortcut' , 40 ,
ColorItem ( 'Button normal' , 41 ,
ColorItem ( 'Button default' , 42 ,
ColorItem ( 'Button selected' , 43 ,
ColorItem ( 'Button disabled' , 44 ,
ColorItem ( 'Button shortcut' , 45 ,
ColorItem ( 'Button shadow' , 46 ,
ColorItem ( 'Cluster normal' , 47 ,
ColorItem ( 'Cluster selected' , 48 ,
ColorItem ( 'Cluster shortcut' , 49 ,
ColorItem ( 'Input normal' , 50 ,
ColorItem ( 'Input selected' , 51 ,
ColorItem ( 'Input arrow' , 52 ,
ColorItem ( 'History button' , 53 ,
ColorItem ( 'History sides' , 54 ,
ColorItem ( 'History bar page' , 55 ,
ColorItem ( 'History bar icons' , 56 ,
ColorItem ( 'List normal' , 57 ,
ColorItem ( 'List focused' , 58 ,
ColorItem ( 'List selected' , 59 ,
ColorItem ( 'List divider' , 60 ,
ColorItem ( 'Information pane' , 61 ,
NIL))))))))))))))))))))))))))))) ,
ColorGroup ( 'Menus' ,
ColorItem ( 'Normal' , 2 ,
ColorItem ( 'Disabled' , 3 ,
ColorItem ( 'Shortcut' , 4 ,
ColorItem ( 'Selected' , 5 ,
ColorItem ( 'Selected disabled' , 6 ,
ColorItem ( 'Shortcut selected' , 7 ,
NIL)))))) ,
ColorGroup ( 'Text' ,
ColorItem ( 'Frame passive' , 8 ,
ColorItem ( 'Frame active' , 9 ,
ColorItem ( 'Frame icons' , 10 ,
ColorItem ( 'Scroll bar page' , 11 ,
ColorItem ( 'Scroll bar icons' , 12 ,
ColorItem ( 'Text' , 13 ,
NIL)))))) ,
NIL))))))) ;
end ;
{===================================================================
SET - dialog with help context
===================================================================}
procedure SetColors ( HelpCtx : word ) ;
var
D : PDialog ;
OldPalette : TPalette ;
begin
D := SetColorsDialog ;
OldPalette := Application^.GetPalette^ ;
D^.HelpCtx := HelpCtx ;
case ExecDialog ( D , Application^.GetPalette ) of
cmCancel : Application^.GetPalette^ := OldPalette ;
end ;
hdRefreshDisplay ;
end ;